OHI British Columbia | OHI Science | Citation policy
knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.path = 'Figs/',
echo = TRUE, message = FALSE, warning = FALSE)
library(ohicore) ### devtools::install_github('ohi-science/ohicore')
source('~/github/ohibc/src/R/common.R')
dir_ohibc <- '~/github/ohibc'
dir_calc <- file.path(dir_ohibc, 'calc_ohibc')
dir_master <- file.path(dir_calc, 'master')
source(file.path(dir_calc, 'calc_scores_fxns.R'))
### provenance tracking
# library(provRmd); prov_setup()Set up scenarios by assigning years. Each scenario (eg. ‘region2015’) will be tied to a specific data year, not floating as in global OHI.
layers.csv)prep_scenario_dirs(dir_calc, dir_master, master_flag = '_master', purge = TRUE)
# prep_scenario_dirs(dir_calc2, dir_master, master_flag = '_master_scenario2', purge = TRUE)
### copy layers from data sources to layers folder
message('Copying all layers to ', file.path(dir_calc, 'layers'))
layers_log <- read_csv(file.path(dir_master, 'layers_ohibc.csv')) %>%
mutate(dir_prep = file.path(dir_ohibc, str_replace(dir_prep, 'ohibc:', '')))
lyrs <- register_layers(layers_log, dir_calc)
verify_layers(lyrs)
copy_layers_to_scenario(lyrs)
write_csv(lyrs %>%
select(-path_in, -path_in_exists, -path_out),
file.path(dir_calc, 'layers.csv'))
### confirm all layers conform to details of layers.csv
conf <- Conf(file.path(dir_calc, 'conf'))
capture.output( ### the function prints a lot crap to screen - let's change those to messages please!
{
CheckLayers(layers.csv = file.path(dir_calc, 'layers.csv'),
layers.dir = file.path(dir_calc, 'layers'),
flds_id = conf$config$layers_id_fields)
},
file = 'delete_this.txt')
unlink('delete_this.txt')layers$data$dir_calc so it can be accessed by functions.Rstatus_years <- read_csv(file.path(dir_calc, 'master/status_year_matrix_master.csv')) %>%
.$status_year %>%
unique()
conf <- Conf(file.path(dir_calc, 'conf'))
layers <- Layers(layers.csv = file.path(dir_calc, 'layers.csv'),
layers.dir = file.path(dir_calc, 'layers'))
layers$data$dir_calc <- dir_calc
layers$data$stat_yr_matrix <- read_csv(file.path(dir_calc, 'conf/status_year_matrix.csv'))
layers$data$year_span <- 1990:2016scores_all <- data.frame() ### initialize scores
for (status_year in status_years) {
# if(!exists('status_year')) status_year <- status_years[1]
message('Calculating scores for ', status_year)
### For each run through loop, assign status_year inside
### the layers object/env't so it is accessible to functions.R
layers$data$status_year <- status_year
capture.output( ### the function prints crap to screen
{
scores <- CalculateAll(conf, layers) %>%
mutate(yr_text = status_year,
year = as.integer(str_replace_all(status_year, '[^0-9]', '')))
},
file = 'delete_this.txt')
unlink('delete_this.txt')
scores_all <- scores_all %>%
bind_rows(scores)
}
write_csv(scores_all, file.path(dir_calc, 'scores_all.csv'))
x <- scores_all %>%
filter(dimension %in% c('status', 'trend')) %>%
filter(!(score == 0 & dimension == 'status'))scores <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
filter(dimension %in% c('status', 'trend')) %>%
spread(dimension, score) %>%
filter(!is.na(status)) %>%
left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))
for(goalname in scores$goal %>% unique() %>% sort) {
# goalname <- scores$goal[1]
scores_tmp <- scores %>%
filter(goal == goalname)
status_plot <- ggplot(scores_tmp %>%
filter(region_id != 0),
aes(x = year, y = status, color = rgn_name)) +
ggtheme_plot() +
geom_line(data = scores_tmp %>%
filter(region_id == 0),
aes(x = year, y = status), size = 1.5, color = 'grey20', alpha = .8) +
geom_line(aes(group = region_id)) +
scale_x_continuous(breaks = scores_tmp$year %>% unique() %>% sort) +
scale_y_continuous(limits = c(0, 100)) +
theme(axis.text.x = element_text(angle = 30)) +
labs(color = goalname)
print(status_plot)
} ## plotting fishery catch weighting by region
stock_plot_df <- read_csv(file.path(dir_ohibc, 'prep/fis/v2017/summary/fis_from_functions.csv')) %>%
group_by(region_id, year) %>%
mutate(total_catch = sum(rgn_catch),
rgn_catch_pct = rgn_catch / total_catch,
total_score = sum(score * rgn_catch) / total_catch) %>%
ungroup() %>%
left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))
for(rgn in 1:8) {
rgn_plot_df <- stock_plot_df %>%
filter(region_id == rgn)
status_plot <- ggplot(rgn_plot_df, aes(x = year, y = score)) +
geom_line(aes(group = stock_id, color = stock_id,
size = rgn_catch_pct),
lineend = 'round', alpha = .5) +
scale_size_continuous(guide = FALSE) +
geom_line(data = rgn_plot_df %>%
select(year, total_score) %>%
distinct(),
aes(x = year, y = total_score),
size = 1.5, color = 'grey30') +
labs(title = first(rgn_plot_df$rgn_name),
color = 'Stock ID',
y = 'Stock Score')
print(status_plot)
}# prov_wrapup(commit_outputs = FALSE)